home *** CD-ROM | disk | FTP | other *** search
/ Computer Shopper 121 / Computer Shopper 121 / Computer Shopper 121.iso / HomeBus / Turbocad / TCW.Z / Smiley.bas < prev    next >
Encoding:
BASIC Source File  |  1997-05-05  |  4.5 KB  |  158 lines
  1. ' This sample program is to illustrate how to create simple scripts for TurboCAD 3.0
  2. '
  3. ' Author    : Mike Cartwright, Tamara Cartwright updated script for 4.0
  4. ' Date        : 11/27/95    01/23/97
  5. '
  6. Global Const BrushSolid = 1
  7. Global Const NULL         = 0
  8. Global Const PI            = 3.141
  9.  
  10. ' Result is a global variable returned by each page to tell the
  11. ' state machine which button was pressed :
  12. Global Const CancelID = 1
  13. Global Const CreateID = 2
  14. Global Const Happy = 0
  15. Global Const Sad = 1
  16. Dim Result As Long
  17. Dim Mood As Long
  18.  
  19. Sub Main ()
  20.     Dim dActive As Long
  21.     ' Active drawing
  22.      dActive = TCWDrawingActive ()
  23.     ' Check for valid drawing
  24.      If dActive = NULL Then
  25.         MsgBox "Program requires active drawing. Open any drawing and try again."
  26.  
  27.         ' Terminate the program       
  28.          Stop    
  29.      End If
  30.  
  31.     Mood = Happy      ' Default is Happy    
  32.  
  33.     MoodDlg    
  34.     if Result = CreateID Then
  35.     CreateSmiley    
  36.     End If
  37. End Sub
  38.  
  39. Sub MoodDlg ()
  40.     Begin Dialog MoodDialog 31, 32, 185, 96, "Create a Smiley!"        
  41.           PushButton 24,  79, 35, 14, "Cancel"       ' CancelID = 0        
  42.           PushButton 144, 79, 35, 14, "&Finish"    ' CreateID = 1         
  43.  
  44.           GroupBox 1, 75, 183, 1, ""        
  45.           GroupBox 100, 12, 72, 48, "Mood"        
  46.           OptionGroup .grp            
  47.              OptionButton 108, 24, 55, 9, "&Happy" ' Option 0            
  48.              OptionButton 108, 40, 55, 9, "&Sad"      ' Option 1        
  49.           GroupBox 10, 12, 82, 48, ""        
  50.           Text      14, 18, 74, 40, "If you are in a great mood choose happy, obviously."    
  51.     End Dialog        
  52.  
  53.     Dim Dlg As MoodDialog    
  54.     Dlg.grp = Mood    
  55.  
  56.     ' Run the dialog ..    
  57.     Result = Dialog(Dlg)    
  58.     Mood = Dlg.grp
  59.  
  60. End Sub
  61.  
  62. ' Called on "Create" to actually create the graphics and add them
  63. ' to the drawing. 
  64.  
  65. Sub CreateSmiley ()     
  66.     Dim dActive As Long    
  67.     Dim Result As Long        
  68.     Dim xc As Double    
  69.     Dim yc As Double    
  70.     Dim errorstr As String    
  71.     Dim g As Long    
  72.     Dim i As Long    
  73.     Dim x As Double    
  74.  
  75.     dActive = TCWDrawingActive ()        
  76.  
  77.     xc = (TCWViewExtentsGetX1() + TCWViewExtentsGetX2())/2
  78.     yc = (TCWViewExtentsGetY1() + TCWViewExtentsGetY2())/2    
  79.  
  80.     ' Create the empty circle graphic    
  81.     g = TCWCircleCenterAndPoint(xc, yc, 0.0, xc, yc+3, 0.0)    
  82.  
  83.     If (g = NULL) Then        
  84.        Result = TCWLastErrorGet(errorstr)        
  85.        MsgBox "Error creating circle : " & errorstr
  86.        Stop
  87.     End If    
  88.  
  89.     ' Color is set as 0x00bbggrr    
  90.     Result = TCWGraphicPropertySet( g, "PenColor", &H0000FFFF)    
  91.  
  92.     ' Fill Pattern is a style. We know that style 1 is always solid    
  93.     Result = TCWGraphicPropertySet( g, "BrushStyle", 1)    
  94.  
  95.     'Select the graphic so we can move it to the back
  96.     Result = TCWGraphicPropertySet( g, "Selected", 1)    
  97.     TCWSendToBack    
  98.     Result = TCWGraphicPropertySet( g, "Selected", 0)    
  99.  
  100.     ' Create the empty circle graphic    
  101.     g = TCWCircleCenterAndPoint(xc, yc, 0.0, xc, yc+3, 0.0)    
  102.  
  103.     If (g = NULL) Then        
  104.        Result = TCWLastErrorGet(errorstr)        
  105.        MsgBox "Error creating circle : " & errorstr
  106.        Stop    
  107.     End If    
  108.  
  109.     ' Color is set as 0x00bbggrr     
  110.     Result = TCWGraphicPropertySet( g, "PenColor", &H000000FF)    
  111.  
  112.     ' Do eyes    
  113.     For i = 0 to 2        
  114.        if i <> 1 Then            
  115.           x = xc - 1.5 * (i-1)            
  116.  
  117.           ' Create the empty circle graphic            
  118.           g = TCWCircleCenterAndPoint(x, yc+1, 0.0, x+.35, yc+1, 0.0)            
  119.           If (g = NULL) Then                
  120.               Result = TCWLastErrorGet(errorstr)                
  121.               MsgBox "Error creating circle for eyes : " & errorstr            
  122.               Stop
  123.           End If            
  124.  
  125.           ' Color is set as 0x00bbggrr            
  126.           Result = TCWGraphicPropertySet (g, "PenColor", &H000000FF)
  127.  
  128.           ' Fill Pattern is a style. We know that style 1 is always solid            
  129.           Result = TCWGraphicPropertySet (g, "BrushStyle", 1)        
  130.        End If    
  131.     Next i    
  132.  
  133.     ' Do Mouth    
  134.  
  135.     ' Create the empty arc graphic            
  136.     ' Set the parameters of the background arc    
  137.     if Mood = Sad Then        
  138.         g = TCWArcCenterAndPoint(xc, yc-3, 0.0, xc+1, yc-3, 0.0, Pi/4, Pi*3/4)    
  139.     Else        
  140.         g = TCWArcCenterAndPoint(xc, yc, 0.0, xc+1, yc+1, 0.0, Pi*5/4, Pi*7/4)    
  141.     End If    
  142.  
  143.     If (g = NULL) Then        
  144.         Result = TCWLastErrorGet(errorstr)        
  145.         MsgBox "Error creating arc for mouth : " & errorstr    
  146.         Stop
  147.     End If    
  148.  
  149.     ' Color is set as 0x00bbggrr    
  150.      Result = TCWGraphicPropertySet( g, "PenColor", &H000000FF)    
  151.  
  152.     ' Make all the graphics into a group    
  153.     TCWSelectAll    
  154.     TCWGroupCreate("smiley")    
  155.     TCWDeselectAll
  156.  
  157. End Sub
  158.